home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Workbench Add-On
/
Workbench Add-On - Volume 1.iso
/
Dev
/
Oberon
/
source
/
Kernel
/
MarkDbg.asm
< prev
Wrap
Assembly Source File
|
1995-06-29
|
8KB
|
230 lines
**********************************************************************
*
* $RCSfile: MarkDbg.asm $
* Description: Runtime support for the Oberon-A compiler
*
* Created by: fjc (Frank Copeland)
* $Revision: 1.3 $
* $Author: fjc $
* $Date: 1995/06/04 23:22:06 $
*
* Copyright © 1994, Frank Copeland.
* This file is part of the Oberon-A Library.
* See Oberon-A.doc for conditions of use and distribution.
*
* Log entries are at the end of the file.
*
**********************************************************************
;---------------------------------------------------------------------
; Program unit hunk name
; !! DO NOT CHANGE UNLESS YOU KNOW WHAT YOU ARE DOING !!
TTL Kernel
;---------------------------------------------------------------------
; Defines
SysBit EQU 0
ArrayBit EQU 1
MarkBitB EQU 7
MarkBitL EQU 31
tag EQU -4
size EQU -16
elemSize EQU -20
arrpos EQU -24
PtrTabOffset EQU 68
id EQU -8
RecordBlkId EQU $52424C4B
ArrayBlkId EQU $41424C4B
SysBlkId EQU $53424C4B
;---------------------------------------------------------------------
;
; PROCEDURE Kernel_Mark (q {A0} : Pointer)
;
; NB: This is a special debug version that checks the id field of each
; memory block and causes a trap if it is not legal.
;
; Kernel_Mark is a direct implementation of the algorithm described in
; the Oberon Technical Notes, part 5 (see TechNotes.doc). It forms
; the inner loop of the mark phase and assumes that the root pointer
; variable passed in A0 has already been marked. The algorithm has
; been modified slightly to reflect the different tag encodings and
; memory block formats used by Oberon-A.
;
; Address registers A1-A3 and all the data registers are free on
; entry.
;
; VAR
; n {A1}, t {A2}, tos {A3} : Pointer;
; offset {D0}, tag {A4,D3} : LONGINT;
; qmask {D1}, ntag {D2} : SET;
;
;---------------------------------------------------------------------
SECTION OberonSys,CODE
XDEF Kernel_Mark
Kernel_Mark:
MOVE.L A4,-(A7) ; (* Create an extra free register *)
BTST.B #ArrayBit,tag+3(A0) ; IF 1 IN q.tag THEN
BEQ.S 2$
CMPI.L #ArrayBlkId,id(A0) ; ASSERT (q.id = ArrayBlkId);
BEQ.S 1$
TRAP #6
BRA.S 1$
DC.L 11$
DC.L 10000
1$ CLR.L arrpos(A0) ; q.arrpos := 0;
MOVE.L #$80000002,D1 ; qmask := {1, 31}
BRA.S 3$
2$ ; ELSE
CMPI.L #RecordBlkId,id(A0) ; ASSERT (q.id = RecordBlkId);
BEQ.S 12$
TRAP #6
BRA.S 12$
DC.L 11$
DC.L $20000
12$ MOVE.L #$80000000,D1 ; qmask := {31}
3$ ; END;
MOVE.L A0,A2 ; t := q;
MOVE.L tag(A0),D3 ; tag := q.tag - {1, 31} + PtrTabOffset
AND.L #$7FFFFFFD,D3
ADD.L #PtrTabOffset,D3
SUB.L A3,A3 ; tos := NIL;
4$ ; LOOP {H}
MOVE.L D3,A4 ; offset := mem[tag];
MOVE.L (A4),D0
BPL.S 7$ ; IF offset < 0 THEN
MOVE.L D3,D4 ; q.tag := tag + offset + qmask;
ADD.L D0,D4
OR.L D1,D4
MOVE.L D4,tag(A0)
BTST.B #ArrayBit,D1 ; IF 1 IN qmask
BEQ.S 5$
MOVE.L elemSize(A0),D4
ADD.L arrpos(A0),D4
CMP.L size(A0),D4 ; & (q.arrpos + q.elemSize # q.size) THEN
BEQ.S 5$
MOVE.L elemSize(A0),D4 ; INC(q.arrpos,q.elemSize);
ADD.L D4,arrpos(A0)
ADD.L D0,D3 ; INC(tag, offset + PtrTabOffset - 4);
ADD.L #PtrTabOffset-4,D3
ADD.L elemSize(A0),A2 ; INC(t, q.elemSize)
BRA 9$
5$:
MOVE.L A3,D4 ; ELSIF tos = NIL THEN
BEQ 10$ ; EXIT
; ELSE
MOVE.L tag(A3),D1 ; qmask := tos.tag;
MOVE.L D1,D3 ; tag := qmask - {1, 31};
AND.L #$7FFFFFFD,D3
AND.L #$80000002,D1 ; qmask := qmask * {1, 31};
MOVE.L A3,A2 ; t := tos;
BTST.B #ArrayBit,D1 ; IF 1 IN qmask THEN
BEQ.S 6$
ADD.L arrpos(A3),A2 ; INC (t, tos.arrpos)
6$: ; END;
MOVE.L D3,A4 ; offset := mem[tag];
MOVE.L (A4),D0
MOVE.L 0(A2,D0.L),A1 ; n := mem[t + offset];
MOVE.L A0,0(A2,D0.L) ; mem[t + offset] := q;
MOVE.L A3,A0 ; q := tos;
MOVE.L A1,A3 ; tos := n
BRA 9$ ; END
7$: ; ELSE
MOVE.L 0(A2,D0.L),D4 ; n := mem[t + offset];
BEQ 9$ ; IF (n # NIL) THEN
MOVE.L D4,A1
MOVE.L tag(A1),D2 ; ntag := n.tag;
BTST.L #MarkBitL,D2 ; IF ~(31 IN ntag) [Unmarked]
BNE 9$
BTST.L #SysBit,D2 ; IF 0 IN ntag THEN
BEQ.S 13$
CMPI.L #SysBlkId,id(A1) ; ASSERT (n.id = SysBlkId)
BEQ.S 14$
TRAP #6
BRA.S 14$
DC.L 11$
DC.L $30000
13$ BTST.L #ArrayBit,D2 ; ELSIF 1 IN ntag THEN
BEQ.S 15$
CMPI.L #ArrayBlkId,id(A1) ; ASSERT (n.id = ArrayBlkId)
BEQ.S 14$
TRAP #6
BRA.S 14$
DC.L 11$
DC.L $40000
15$ ; ELSE
CMPI.L #RecordBlkId,id(A1) ; ASSERT (n.id = RecordBlkId)
BEQ.S 14$
TRAP #6
BRA.S 14$
DC.L 11$
DC.L $50000
14$ ; END;
BSET.B #MarkBitB,tag(A1) ; n.tag := n.tag + {31};
BTST.L #SysBit,D2 ; IF ~(0 IN ntag) THEN [~SysBlk]
BNE.S 9$
MOVE.L D3,tag(A0) ; q.tag := tag + qmask;
OR.L D1,tag(A0)
BTST.B #ArrayBit,D2 ; IF ~(1 IN ntag) THEN
BNE.S 8$
MOVE.L A3,0(A2,D0.L) ; mem[t + offset] := tos;
MOVE.L A0,A3 ; tos := q;
MOVE.L A1,A0 ; q := n;
MOVE.L A0,A2 ; t := q;
MOVE.L D2,D3 ; tag := ntag + PtrTabOffset - 4;
ADD.L #PtrTabOffset-4,D3
MOVE.L #$80000000,D1 ; qmask := {31}
BRA.S 9$
8$:
BTST.B #SysBit,D2 ; ELSIF ~(0 IN ntag) THEN
BNE.S 9$
MOVE.L A3,0(A2,D0.L) ; mem[t + offset] := tos;
MOVE.L A0,A3 ; tos := q;
MOVE.L A1,A0 ; q := n;
CLR.L arrpos(A0) ; q.arrpos := 0;
MOVE.L A0,A2 ; t := q;
MOVE.L D2,D3 ; tag := ntag - {1} + PtrTabOffset - 4;
BCLR.B #ArrayBit,D3
ADD.L #PtrTabOffset-4,D3
MOVE.L #$80000002,D1 ; qmask := {1, 31}
; END (* ELSIF *)
; END
; END (* IF *)
; END (* IF *)
9$: ; END; (* ELSE *)
ADDQ.L #4,D3 ; INC(tag, 4)
BRA 4$ ; END (* LOOP *)
10$:
MOVE.L (A7)+,A4 ; (* restore A4 *)
RTS
11$:
DC.B "Kernel_Mark",0
;---------------------------------------------------------------------
END ; Kernel
**********************************************************************
*
* $Log: MarkDbg.asm $
;; Revision 1.3 1995/06/04 23:22:06 fjc
;; - Release 1.6
;;
;; Revision 1.2 1995/01/26 00:37:31 fjc
;; - Release 1.5
;;
;; Revision 1.1 1995/01/09 18:29:01 fjc
;; Initial revision
;;
**********************************************************************